home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / Balloon Help Tool / MakeBHT.p < prev    next >
Encoding:
Text File  |  1996-09-06  |  8.1 KB  |  278 lines  |  [TEXT/CWIE]
  1. program MakeBHT;
  2. uses 
  3.     ConditionalMacros,MixedMode,Types, QuickDraw,fp,fenv,fixmath, Strings, Events, Windows,PictUtils,GestaltEqu,    AERegistry,AEObjects,AEPackObject,Aliases,AppleScript,ASRegistry,OSAComp,OSA,OSAGeneric,
  4.     Dialogs, Fonts, DiskInit, TextEdit,Traps, Devices, Memory, SegLoad,FSM,Displays,
  5.     Translation,TranslationExtensions,{For Macintosh Easy open}
  6.     Scrap, ToolUtils, OSUtils, Menus, Palettes,Processes, PPCToolbox, EPPC,ColorPicker,
  7.     Notification, AppleEvents,QDOffscreen,Folders,Controls,TextUtils,script,Packages,
  8.     Editions,Lists,files,StandardFile,Resources,Printing, Sound, DeskBus,Video,
  9.     imageCompression, QuickTimeComponents, imageCodec, MoviesFormat, Movies, MediaHandlers,AIFF,SoundInput,SoundComponents,Speech;
  10. {Standard UPI header stuff}
  11.  
  12. const
  13. var
  14.     OutVol, ApplResFile: Integer;
  15.     GlobalError: Integer;
  16. function NumToStr (num: double_t; NDig: Integer): Str255;
  17. begin
  18.     NumToStr := StringOf(Num:0:Ndig);
  19. end;
  20. procedure ShowError (Code: LongInt);
  21.     const
  22.         IsStop = 0;
  23.         IsCaution = 1;
  24.         IsNote = 2;
  25.         ErrorAlrtID = 1003;
  26.         IOErrStrID = 450;
  27.     var
  28.         S, S1: Str255;
  29.         Itemhit: Integer;
  30.         Abort: Boolean;
  31.  
  32.     function ALertResponse (WhichAlert, AlertType: Integer): Integer;
  33.         var
  34.             HAlrt: AlertTHndl;
  35.             X, Y: Integer;
  36.             Width, Height: Integer;
  37.         begin
  38.             ALertResponse := 1;
  39.             HAlrt := AlertTHndl(GetResource('ALRT', WhichAlert));
  40.             if HAlrt <> nil then
  41.                 begin
  42.                     with HAlrt^^.BoundsRect do
  43.                         begin
  44.                             Width := (Right - left);
  45.                             Height := (Bottom - Top);
  46.                         end;
  47.                     with Qd.SCREENBITS.BOUNDS do
  48.                         begin
  49.                             X := Left + (Right - Left - Width) div 2;
  50.                             Y := 50;{25 pixels below Menubar}
  51.                         end;
  52.                     SetRect(HAlrt^^.BoundsRect, X, Y, X + Width, Y + Height);
  53.                     ParamText(S, S1, '', '');
  54.                     case AlertType of
  55.                         IsStop: 
  56.                             ALertResponse := StopAlert(WhichAlert, nil);
  57.                         IsCaution: 
  58.                             ALertResponse := CautionAlert(WhichAlert, nil);
  59.                         IsNote: 
  60.                             ALertResponse := NoteAlert(WhichAlert, nil);
  61.                     end;
  62.                 end;
  63.         end;
  64.     begin
  65.         itemhit := SetVol(nil, OutVol);
  66.         UseResFile(ApplResFile);
  67.         if code <> NoErr then
  68.             sysbeep(1);
  69.         case Code of  {**Convert # to Message**}
  70.             NoErr: {Final message}
  71.                 Itemhit := 15;{Should be the last item in the strings}
  72.             -39, -36: 
  73.                 itemhit := 2;{Emty File,Data Miss, Blank Line Err}
  74.             -130: 
  75.                 itemhit := 3;{bad data in X or Y col error}
  76.             -33, -34, -194: 
  77.                 itemhit := 7;{FullDsk Err}
  78.             -44, -45, -46, -54, -61: 
  79.                 itemhit := 8;{Locked dsk/file Err}
  80.             -35, -43, -53, -192, -193: 
  81.                 itemhit := 9;{Nofindfolder}
  82.             -27: 
  83.                 itemhit := 13;{Unknown printing error}
  84.             -47, -49: 
  85.                 ItemHit := 14;{File already open}
  86.             otherwise
  87.                 Itemhit := 12;{SYS Error or unknown type error}
  88.         end;
  89.         SetCursor(Qd.Arrow);
  90.         S := '';
  91.         GetIndString(S1, IOErrStrID, itemhit);
  92.         if itemhit = 15 then
  93.             Abort := ALertResponse(ErrorAlrtID, isNote) > 0
  94.         else {}
  95.             if (itemhit = 12) and (Code > 0) then
  96.                 begin {System error}
  97.                     SysError(Code);
  98.                     ExitToShell;
  99.                 end
  100.             else
  101.                 begin
  102.                     S := Concat('Error# ', NumtoStr(Code, 0));
  103.                     if itemhit = 12 then
  104.                         SysError(Code)
  105.                     else
  106.                         Abort := ALertResponse(ErrorAlrtID, isStop) > 0;
  107.                 end;
  108.     end;
  109.  
  110. Procedure DisToBallons;
  111. const
  112.     CheckedC = Chr(CheckMark);
  113.     NoMarkC = chr(nomark);
  114. var
  115.     ThisMenu:MenuRef;
  116.     menuID,first,last:Integer;
  117.     ThisItem, firstitem, lastitem:Integer;
  118.     optType,TheItem,itemhit: Integer;
  119.     ItemHdl: Handle;
  120.     OptBox: rect;
  121.     S,S1,S2:Str255;
  122.     TheStatFlag:Integer;
  123.     TheDialog:Dialogptr;
  124.     theactualID: INTEGER;
  125.     theRType: ResType;
  126.     WatchCursor: Cursor;
  127.     hcurs: CursHandle;
  128.     Fout:Text;
  129.     TempResHandle:Handle;
  130.     FileInNum:Integer;
  131.     Where:Point;
  132.     typeList: SFTypeList;
  133.     Reply: SFReply;
  134.     AChar:Char;
  135. Begin
  136.     SetPt(Where, -1, -1);{Auto center the Open file dialog}
  137.     S := ' ';
  138.     TypeList[0] := 'APPL';
  139.     TypeList[1] := 'rsrc';
  140.     SFGetFile(Where, S, nil, 2, @TypeList, nil, Reply);
  141.     if Reply.Good then
  142.     begin
  143.         Hcurs := GetCursor(401);{Watch}
  144.         WatchCursor := Hcurs^^;
  145.         SetCursor(WatchCursor);
  146.         itemhit := SetVol(nil, Reply.vRefnum);
  147.         S := Reply.Fname;
  148.         FileInNum := OpenResFile(S);{The current resource is now MCC π or ƒ}
  149.         GlobalError := ResError;
  150.         if (GlobalError <> NoErr) or (FileInNum = -1) then
  151.         begin
  152.             if GlobalError = NoErr then
  153.                 GlobalError := -192;{Resource not found}
  154.             showerror(GlobalError);
  155.             Exit(DisToBallons);{Failed}
  156.         end;
  157.         S := concat(Reply.Fname,'.bh');
  158.         ReWrite(Fout,S);
  159.         UseResFile(FileInNum);
  160.         last := Count1Resources('MENU');
  161.         for menuID := 1 to last do
  162.         begin
  163.             TempResHandle := Get1IndResource('MENU', menuID);
  164.             if (TempResHandle <> nil) and (reserror = noerr) then
  165.             Begin
  166.                 GetResInfo(TempResHandle, theactualID, theRType, S);
  167.                 ReleaseResource(TempResHandle);
  168.                 ThisMenu := GetMenu(theactualID);
  169.                 lastitem := CountMItems(ThisMenu);
  170.                 S := concat('MENU ',NumtoStr(theactualID,0),' ',S);{should be MENU 80 name}
  171.                 Writeln(Fout,S);
  172.                 for ThisItem := 1 to lastitem do
  173.                 begin
  174.                     GetMenuItemText(ThisMenu, ThisItem, S);
  175.                     GetItemMark(ThisMenu,ThisItem,AChar);
  176.                     if AChar = NoMarkC then
  177.                         TheStatFlag := 1 + ord(S='-')
  178.                     else
  179.                         if AChar = CheckedC then
  180.                             TheStatFlag := 3
  181.                         else
  182.                             TheStatFlag := 4;{something else}
  183.                     S := concat(NumtoStr(ThisItem+TheStatFlag*0.10,1),' ',S);
  184.                     Writeln(Fout,S);
  185.                 end;
  186.                 S := 'END-MENU';
  187.                 Writeln(Fout,S);
  188.                 DisposeMenu(ThisMenu);
  189.             end;
  190.         end;{Of menu loop}
  191.         last := Count1Resources('DLOG');
  192.         for menuID := 1 to last do
  193.         begin
  194.             TempResHandle := Get1IndResource('DLOG', menuID);
  195.             if (TempResHandle <> Nil) and (ResError = noerr) then
  196.             Begin
  197.                 GetResInfo(TempResHandle, theactualID, theRType, S);
  198.                 ReleaseResource(TempResHandle);
  199.                 TheDialog := GetNewDialog(theactualID, nil, Pointer(-1));
  200.                 S := concat('DIALOG ',NumToStr(theactualID,0),' ',S);
  201.                 Writeln(Fout,S);
  202.                 {Write it out}
  203.                 lastitem := CountDitl(TheDialog);{Current # of items in ditl list}
  204.                 for ThisItem := 1 to lastitem do
  205.                 begin
  206.                     GetDialogItem(TheDialog, ThisItem, optType, ItemHdl, OptBox);
  207.                     if optType >= itemDisable then
  208.                     Begin
  209.                         optType := optType - itemDisable;
  210.                         TheStatFlag := 2;
  211.                     end
  212.                     else
  213.                         TheStatFlag := 1;
  214.                     case optType of
  215.                         0 : S2 := 'utm';{user item}
  216.                         4 : S2 := 'btn';{button}
  217.                         5 : S2 := 'cbx';{checkbox}
  218.                         6 : S2 := 'rbt';{radiobutton}
  219.                         7: S2 := 'cnt';{Some sort of res control probably a scroll bar}
  220.                         8 : S2 := 'stt';{stattext}
  221.                         16 : S2 := 'ett';{edit text}
  222.                         32 : S2 := 'icn';{icon}
  223.                         64 : S2 := 'pic';{pict}
  224.                         otherwise {unknows}
  225.                             S2 := '???';
  226.                     end;
  227.                     if optType in [4,5,6] then {get control name}
  228.                     Begin
  229.                         GetControlTitle(ControlRef(ItemHdl),S1);
  230.                         if TheStatFlag = 1 then {it's on}
  231.                         Begin
  232.                             TheStatFlag := 1+ GetControlValue(ControlRef(ItemHdl))*2;
  233.                             if TheStatFlag > 3 then
  234.                                 TheStatFlag := 4;
  235.                         end;
  236.                     end
  237.                     else
  238.                          if (optType = 8) or (optType = 16) then {get string name}
  239.                              GetDialogItemText(ItemHdl,S1)
  240.                          else
  241.                              S1 := '';
  242.                     S := Concat(Numtostr((ThisItem+TheStatFlag*0.10),1),' •',S2,'• ', S1);
  243.                     Writeln(Fout,S);
  244.                 end;{for ditl item loop}
  245.                 S := 'END-DIALOG';{post this too}
  246.                 Writeln(Fout,S);
  247.                 DisposeDialog(TheDialog);
  248.             end;{of error check for good restype}
  249.         end; {of dialog loop}
  250.         Writeln(Fout,'END');
  251.         Close(Fout);
  252.         CLoseResFile(FileInNum);
  253.         UseResFile(ApplResFile);
  254.     end;
  255. end;
  256. begin
  257.     MaxApplZone;                  { expand application heap to maximum }
  258.     MoreMasters;{This allocates }
  259.     MoreMasters;{This allocates }
  260.     MoreMasters;{This allocates }
  261.     MoreMasters;{This allocates }
  262.     MoreMasters;{This allocates }
  263.     MoreMasters;{This allocates }
  264.     MoreMasters;{This allocates }
  265.     MoreMasters;{This allocates }
  266.     MoreMasters;{This allocates }
  267.     MoreMasters;{This allocates }
  268.     InitGraf(@Qd.ThePort);           { initialize QuickDraw }
  269.     InitFonts;                    {     "      Font Manager }
  270.     InitWindows;                  {     "      Window Manager }
  271.     InitMenus;                    {     "      Menu Manager }
  272.     TEInit;                       {     "      Text Edit }
  273.     InitDialogs(nil);       {@TryAgain     "      Dialog Manager }
  274.     InitCursor;                   { change to arrow cursor }
  275.     ApplResFile := CurResFile;
  276.     GlobalError := GetVol(nil, OutVol);
  277.     DisToBallons;
  278. end.